home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 8 / FM Towns Free Software Collection 8.iso / t_os / sym_dosv / sym_dosv.bas next >
Encoding:
BASIC Source File  |  1994-06-01  |  23.6 KB  |  704 lines

  1. 10000 '
  2. 10010 CLEAR ,,,,,300*1024         ' def font DLL 領域
  3. 10020 DEFINT A-Z
  4. 10030 DIM TBL#(99,1),TW_FNT$(25)
  5. 10040 DIM GR%(99)                 ' 後で再定義するが...
  6. 10050 PALETTE 0,[4*16,2*16,4*16]  ' 背景色
  7. 10060 'GOSUB *FILE_NAME
  8. 10070 'END
  9. 10080 '
  10. 10090 P = 0
  11. 10100 READ F$:WHILE F$ <> "*"
  12. 10110     TW_FNT$(P) = F$
  13. 10120     P = P + 1
  14. 10130 READ F$:WEND
  15. 10140 TW_FNT_MAX = P
  16. 10150 DATA "システム   12ドット"
  17. 10160 DATA "システム   16ドット"
  18. 10170 DATA "明朝体     24ドット"
  19. 10180 DATA "ゴシック体 24ドット"
  20. 10190 DATA "教科書体   24ドット"
  21. 10200 DATA "まるもじ   24ドット"
  22. 10210 DATA "明朝体     32ドット"
  23. 10220 DATA "ゴシック体 32ドット"
  24. 10230 DATA "明朝体     48ドット"
  25. 10240 DATA "ゴシック体 48ドット"
  26. 10250 DATA "明朝体     60ドット"
  27. 10260 DATA "ゴシック体 60ドット"
  28. 10270 DATA "毛筆体     48ドット"
  29. 10280 'DATA "明朝体        ベクトル(ICカード)"
  30. 10290 'DATA "ゴシック体    ベクトル(ICカード)"
  31. 10300 'DATA "丸ゴシック体  ベクトル(ICカード)"
  32. 10310 DATA *
  33. 10320 CLS
  34. 10330 PRINT "   --------------------------"
  35. 10340 PRINT "       SYM_DOSV"
  36. 10350 PRINT "   --------------------------"
  37. 10360 PRINT "TOWNSの多様なフォントを元に DOS/V用のフォントファイルを"
  38. 10370 PRINT "作成するものです."
  39. 10380 PRINT "全角フォントのみ対応しています."
  40. 10390 PRINT "フォントファイルに含まれる文字を指定するために,基準用のフォントファイルが"
  41. 10400 PRINT "必要です."
  42. 10410 PRINT "作成されたフォントファイルには 富士通の著作権がありますので 個人使用に"
  43. 10420 PRINT "止めてください。"
  44. 10430 PRINT
  45. 10440 '
  46. 10450 *TOP
  47. 10460 PRINT
  48. 10470 PRINT "◆TOWNS側使用フォント"
  49. 10480 PRINT "    INSTALL していないフォントを使用するときは, SYSTEM CD をセットして"
  50. 10490 PRINT "    ください."
  51. 10500 PRINT
  52. 10510 P = 0 :I$ = ""
  53. 10520 WHILE I$ <> CHR$(13)
  54. 10530 '                                              "丸ゴシック体  ベクトル(ICカード)"
  55. 10540     PRINT USING CHR$(13)+"使用フォント選択  <[&                 &]>";TW_FNT$(P);
  56. 10550     I$ = INPUT$(1)
  57. 10560     IF I$ = "6" OR I$ = CHR$(&H1C) THEN
  58. 10570         P = P + 1
  59. 10580         IF P = TW_FNT_MAX THEN P = 0
  60. 10590     ELSE IF I$ = "4" OR I$ = CHR$(&H1D) THEN
  61. 10600         P = P - 1
  62. 10610         IF P = -1 THEN P = TW_FNT_MAX -1
  63. 10620     ENDIF
  64. 10630 WEND
  65. 10640 PRINT
  66. 10650 SYM_FNT$ = TW_FNT$(P)
  67. 10660 '
  68. 10670 'X,Ysize
  69. 10680 PRINT
  70. 10690 PRINT "◆フォントサイズ"
  71. 10700 PRINT "    作成するフォントの縦横のドット数を指定します."
  72. 10710 PRINT
  73. 10720 P = 24
  74. 10730 I$ = ""
  75. 10740 WHILE I$ <> CHR$(13)
  76. 10750     PRINT USING CHR$(13)+"横ドット数(3-99)  <[##]>";P;
  77. 10760     I$ = INPUT$(1)
  78. 10770     IF I$ = "6" OR I$ = CHR$(&H1C) THEN
  79. 10780         P = P + 1
  80. 10790         IF P = 100 THEN P = 99
  81. 10800     ELSE IF I$ = "4" OR I$ = CHR$(&H1D) THEN
  82. 10810         P = P - 1
  83. 10820         IF P = 2 THEN P = 3
  84. 10830     ENDIF
  85. 10840 WEND
  86. 10850 PRINT
  87. 10860 X_SIZE = P
  88. 10870 I$ = ""
  89. 10880 WHILE I$ <> CHR$(13)
  90. 10890     PRINT USING CHR$(13)+"縦ドット数(3-99)  <[##]>";P;
  91. 10900     I$ = INPUT$(1)
  92. 10910     IF I$ = "6" OR I$ = CHR$(&H1C) THEN
  93. 10920         P = P + 1
  94. 10930         IF P = 100 THEN P = 99
  95. 10940     ELSE IF I$ = "4" OR I$ = CHR$(&H1D) THEN
  96. 10950         P = P - 1
  97. 10960         IF P = 2 THEN P = 3
  98. 10970     ENDIF
  99. 10980 WEND
  100. 10990 PRINT
  101. 11000 Y_SIZE = P
  102. 11010 PRINT
  103. 11020 PRINT "◆太文字指定"
  104. 11030 PRINT "    横に1ドット太いフォントを作成します."
  105. 11040 PRINT
  106. 11050 BOLD = 0
  107. 11060 I$ = " "
  108. 11070 WHILE I$ <> CHR$(13)
  109. 11080     IF BOLD = 0 THEN
  110. 11090         PRINT CHR$(13)+"    [ 通常文字 ]   太 文 字  ";
  111. 11100     ELSE
  112. 11110         PRINT CHR$(13)+"      通常文字   [ 太 文 字 ]";
  113. 11120     ENDIF
  114. 11130     I$ = INPUT$(1)
  115. 11140     IF INSTR("46"+CHR$(&H1C)+CHR$(&H1D),I$) THEN
  116. 11150         BOLD = -(BOLD = 0)
  117. 11160     ENDIF
  118. 11170 WEND
  119. 11180 PRINT
  120. 11190 '
  121. 11200 PRINT
  122. 11210 PRINT "◆フォント名"
  123. 11220 PRINT "    フォントファイルに書き込むフォント名を指定します."
  124. 11230 PRINT "    半角 8文字まで."
  125. 11240 PRINT
  126. 11245 PRINT "(省略時:TOWNS)"
  127. 11250 *F_NAME_IN
  128. 11260 PRINT "フォント名:";
  129. 11270 LINE INPUT N$
  130. 11280 IF N$ = "" THEN N$ = "TOWNS"
  131. 11290 IF LEN(N$) > 8  THEN GOTO *F_NAME_IN
  132. 11300 F_NAME$ = N$
  133. 11310 PRINT
  134. 11320 '
  135. 11330 PRINT
  136. 11340 PRINT "◆基準フォントファイル"
  137. 11350 PRINT "  FONTEX用のフォントファイルを指定してください."
  138. 11360 PRINT "  サイズの違うフォントファイルでもかまいません."
  139. 11370 PRINT "  このファイルで使用している文字と同じ文字を含むフォントファイルを"
  140. 11380 PRINT "  作成します."
  141. 11390 PRINT
  142. 11400 FL_RDWT = 0
  143. 11410 GOSUB *FL_NAME
  144. 11420 I_FILE$ = FL_NAME$
  145. 11430 '
  146. 11440 PRINT
  147. 11450 PRINT "◆出力ファイル名"
  148. 11460 PRINT "  作成するファイル名です."
  149. 11470 PRINT "  同名ファイルがあるときは,バックアップファイルを作成します."
  150. 11480 PRINT
  151. 11490 FL_RDWT = 1
  152. 11500 GOSUB *FL_NAME
  153. 11510 O_FILE$ = FL_NAME$
  154. 11520 PRINT
  155. 11530 '
  156. 11540 PRINT ""
  157. 11550 PRINT "---------------------------------------------------------"
  158. 11560 PRINT "  使用フォント         : ";SYM_FNT$
  159. 11570 PRINT "  フォントサイズ       : X=";X_SIZE;"dot   Y=";Y_SIZE;"dot"
  160. 11580 PRINT "  太文字指定           : ";
  161. 11590 IF BOLD = 0 THEN PRINT "通常文字" ELSE PRINT "太 文 字"
  162. 11600 PRINT "  フォント名           : ";F_NAME$
  163. 11610 PRINT "  基準フォントファイル : ";I_FILE$
  164. 11620 PRINT "  出力ファイル名       : ";O_FILE$
  165. 11630 PRINT "---------------------------------------------------------"
  166. 11640 PRINT "                              以上の設定でよろしいですか."
  167. 11650 I = 0
  168. 11660 I$ = ""
  169. 11670 WHILE I$ <>CHR$(13)
  170. 11680     IF I = 0 THEN
  171. 11690         PRINT CHR$(13)+"             [ 決 定 ]        再設定   ";
  172. 11700     ELSE
  173. 11710         PRINT CHR$(13)+"               決 定        [ 再設定 ] ";
  174. 11720     ENDIF
  175. 11730     I$ = INPUT$(1)
  176. 11740     IF INSTR("46"+CHR$(&H1D)+CHR$(&H1C),I$) THEN
  177. 11750         I = -(I=0)
  178. 11760     ENDIF
  179. 11770 WEND
  180. 11780 PRINT
  181. 11790 IF I = 1 THEN GOTO *TOP
  182. 11800 '---------------------------------------------------------------------------
  183. 11810 ' DOS/V font write
  184. 11820 '
  185. 11825 PRINT "----- フォントファイルを作成します -----"
  186. 11826 TIME$ = "00:00:00"
  187. 11830 DEF FONT SYM_FNT$
  188. 11840 FT_BYTS = INT((X_SIZE+7)/8) * Y_SIZE
  189. 11850 ERASE GR% : DIM GR%(FT_BYTS/2 + 1)
  190. 11860 CNT_X = INT(640/(X_SIZE+1))  ' bold 処理の為 +1
  191. 11870 CNT_Y = INT(460/(Y_SIZE))
  192. 11880 CNT_N = CNT_X * CNT_Y
  193. 11900 '
  194. 11910 '-- 基準用ファイルリード --
  195. 11920     PRINT "  基準ファイル読み込み"
  196. 11930     OPEN "I",#1,I_FILE$
  197. 11940 ' ID check
  198. 11950     I$ = INPUT$(6,1)
  199. 11960     IF I$ <> "FONTX2" THEN
  200. 11970         PRINT "FONTEX用フォントではありません。"
  201. 11980         GOTO *FONTEX_ERROR
  202. 11990     ENDIF
  203. 12000 ' FONT NAME
  204. 12010     I$ = INPUT$(8,1)
  205. 12020     PRINT "  FONT NAME =" + I$
  206. 12030 ' FONT SIZE
  207. 12040     I$ = INPUT$(2,1)
  208. 12050     PRINT "  SIZE: X = ## Y = ##";ASC(MID$(I$,1,1));ASC(MID$(I$,2,1))
  209. 12060 ' FONT TYPE
  210. 12070     I$ = INPUT$(1,1)
  211. 12080     IF I$ = CHR$(0) THEN
  212. 12090 CLS
  213. 12100         PRINT "半角のフォントファイルです。"
  214. 12110         GOTO *FONTEX_ERROR
  215. 12120     ENDIF
  216. 12130 ' 領域テーブル個数
  217. 12140     I$ = INPUT$(1,1)
  218. 12150     TBL_MAX = ASC(I$)
  219. 12160     PRINT "  領域数 =";TBL_MAX
  220. 12170 ' 領域テーブル読み込み
  221. 12180     FOR I = 0 TO TBL_MAX -1
  222. 12190         I$ = INPUT$(4,1)
  223. 12200         TBL#(I,0) = ASC(MID$(I$,2,1))*256 + ASC(MID$(I$,1,1))
  224. 12210         TBL#(I,1) = ASC(MID$(I$,4,1))*256 + ASC(MID$(I$,3,1))
  225. 12220         PRINT USING "[$&  & - $&  &] ";HEX$(TBL#(I,0));HEX$(TBL#(I,1));
  226. 12230     NEXT
  227. 12240     CLOSE #1
  228. 12250     PRINT
  229. 12260 '
  230. 12270 '-- 出力ファイルオープン --
  231. 12280     OPEN "O",#1,FL_NAME$
  232. 12290 ' ヘッダ書き込み
  233. 12300     PRINT #1,"FONTX2";                            'ID
  234. 12310     PRINT #1,LEFT$(F_NAME$+STRING$(8,CHR$(0)),8); 'フォント名
  235. 12320     PRINT #1,CHR$(X_SIZE)+CHR$(Y_SIZE);           'フォントサイズ 16x16
  236. 12330     PRINT #1,CHR$(1);                             'フォントタイプ 全角
  237. 12340     PRINT #1,CHR$(TBL_MAX);                       '領域テーブル出力
  238. 12350     FOR I = 0 TO TBL_MAX -1                       '
  239. 12360         PRINT #1,CHR$(TBL#(I,0)MOD 256)+CHR$(TBL#(I,0)\ 256);
  240. 12370         PRINT #1,CHR$(TBL#(I,1)MOD 256)+CHR$(TBL#(I,1)\ 256);
  241. 12380     NEXT
  242. 12390 ' フォント本体書き込み
  243. 12400 FX = 0:FY = 0
  244. 12410 CLS
  245. 12420 LINE (0,18)-(639,18),PSET
  246. 12430 FOR F = 0 TO TBL_MAX -1
  247. 12440     LOCATE 57,0
  248. 12450     PRINT USING "## / ## : &  & - &  &";TBL_MAX;F+1;HEX$(TBL#(F,0));HEX$(TBL#(F,1));
  249. 12460     FOR P = 0 TO TBL#(F,1)-TBL#(F,0)
  250. 12470         SJ_CODE# = TBL#(F,0) + P
  251. 12480         IF FX = 0 THEN
  252. 12490             LINE (0,FY*Y_SIZE+20)-STEP(639,Y_SIZE-1),PSET,0,BF
  253. 12500         ENDIF
  254. 12510         LOCATE 2,0
  255. 12520         PRINT USING "作業中 (&  &) ...      [ESC] 中止";HEX$(SJ_CODE#);
  256. 12530         IF BOLD = 0 THEN
  257. 12540             SYMBOL (FX*(X_SIZE+1),FY*Y_SIZE+20),CHR$(SJ_CODE# \ 256)+CHR$(SJ_CODE# MOD 256),X_SIZE/16,Y_SIZE/16
  258. 12550         ELSE  ' BOLD
  259. 12560             SYMBOL (FX*(X_SIZE+1),FY*Y_SIZE+20),CHR$(SJ_CODE# \ 256)+CHR$(SJ_CODE# MOD 256),X_SIZE/16,Y_SIZE/16,,,,1
  260. 12570         ENDIF
  261. 12580         GET@ (FX*(X_SIZE+1),FY*Y_SIZE+20)-(FX*(X_SIZE+1)+X_SIZE-1,FY*Y_SIZE+20+Y_SIZE-1),GR%
  262. 12590         GR_AD& = VARPTR(GR%(0))
  263. 12600         FOR I = 0 TO FT_BYTS-1
  264. 12610             PRINT #1,CHR$(PEEK(GR_AD& + I));
  265. 12620         NEXT
  266. 12630         'I$ = ""
  267. 12640         'FOR I = 0 TO FT_TYTS
  268. 12650         '     I$ = I$ + CHR$(PEEK(GR_AD& + I))
  269. 12660         '     IF LEN(I$) > 250 THEN
  270. 12670         '         PRINT #1,I$;
  271. 12680         '         I$ = ""
  272. 12690         '     ENDIF
  273. 12700         'NEXT
  274. 12710         'IF LEN(I$)> 0 THEN PRINT #1,I$;
  275. 12720         ' グラフィック座標更新
  276. 12730         FX = FX + 1
  277. 12740         IF FX >= CNT_X THEN
  278. 12750             FX = 0
  279. 12760             FY = FY + 1
  280. 12770             IF FY >= CNT_Y THEN
  281. 12780                 FY = 0
  282. 12790             ENDIF
  283. 12800         ENDIF
  284. 12810         I$ = INKEY$  ' 中止処理
  285. 12820         IF I$ = CHR$(&H1B) THEN
  286. 12830             P = TBL#(F,1)-TBL#(F,0)
  287. 12840             F = TBL_MAX -1
  288. 12850             ABORT = 1
  289. 12860         ENDIF
  290. 12870     NEXT
  291. 12880 NEXT
  292. 12890 *FONTEX_ERROR
  293. 12900 CLOSE #1
  294. 12910 CLS
  295. 12920 IF ABORT = 1 THEN
  296. 12930     KILL O_FILE$
  297. 12940     PRINT "作業を中止しました."
  298. 12950     QUIT = 0
  299. 12960 ELSE
  300. 12965     PRINT "作業時間 = " +TIME$
  301. 12970     PRINT "作業を終了しました。"
  302. 12980     QUIT = 1
  303. 12990 ENDIF
  304. 13000 ABORT = 0
  305. 13010 PRINT ""
  306. 13020 I$ = " "
  307. 13030 WHILE I$ <> CHR$(13)
  308. 13040     IF QUIT = 0 THEN
  309. 13050         PRINT CHR$(13)+"    [ 再実行 ]   終了 ";
  310. 13060     ELSE
  311. 13070         PRINT CHR$(13)+"      再実行   [ 終了 ]";
  312. 13080     ENDIF
  313. 13090     I$ = INPUT$(1)
  314. 13100     IF INSTR("46"+CHR$(&H1C)+CHR$(&H1D),I$) THEN
  315. 13110         QUIT = -(QUIT = 0)
  316. 13120     ENDIF
  317. 13130 WEND
  318. 13140 PRINT
  319. 13150 IF QUIT = 0 THEN *TOP
  320. 13160 '
  321. 13170 '
  322. 13180 'SYSTEM
  323. 13190 END
  324. 18900 '---- ファイル名入力 -------------------------------------------------------
  325. 18910 *FL_NAME
  326. 18920 '  in  fL_rdwt , fl_def$
  327. 18930 '  out fl_name$
  328. 18940 '
  329. 18950     IF FL_CDIR$ = "" THEN FL_CDIR$ = ".\"
  330. 18960 '
  331. 18970 *FL_NAME2
  332. 18980     PRINT FL_CDRV$ + FL_CDIR$+">";
  333. 18990     LINE INPUT FL_CLINE$
  334. 19000 '
  335. 19010 '入力で \ のかわりに / で入力できるように
  336. 19020     FOR FL_I = 1 TO LEN(FL_CLINE$)
  337. 19030         IF MID$(FL_CLINE$,FL_I,1) = "/" THEN MID$(FL_CLINE$,FL_I,1) = "\"
  338. 19040     NEXT
  339. 19050 '
  340. 19060     GOSUB *FL_PRM
  341. 19070 '
  342. 19080 'default
  343. 19090     IF FL_PRM$ = "" THEN
  344. 19100         IF FL_DEF$ <> "" THEN
  345. 19110             FL_PRM$ = FL_DEF$
  346. 19120         ELSE
  347. 19130             FL_PRM$ = "*.*"
  348. 19140         ENDIF
  349. 19150     ENDIF
  350. 19160 '
  351. 19170 'cls
  352. 19180     IF FL_PRM$ = "cls" OR FL_PRM$ = "CLS" THEN
  353. 19190         CLS 1
  354. 19200         GOTO *FL_NAME2
  355. 19210     ENDIF
  356. 19220 '
  357. 19230 'help
  358. 19240     IF FL_PRM$ = "help" OR FL_PRM$ = "HELP" OR FL_PRM$ = "?" THEN
  359. 19250         PRINT "---------------------------------------------------"
  360. 19260         PRINT "  (*,?)を含む       files"
  361. 19270         PRINT "  drv:              ドライブ変更"
  362. 19280         PRINT "  [drv:]dir\        カレント変更 & files"
  363. 19290         PRINT "  DIR [drv:]dir     files"
  364. 19300         PRINT "  CD [drv:]dir      カレント変更"
  365. 19310         PRINT "  DEL fname         削除"
  366. 19320         PRINT "  REN fname fname   リネーム"
  367. 19330         PRINT "  TYPE fname        ファイル表示"
  368. 19340         PRINT "  CLS               画面消去"
  369. 19350         PRINT "  HELP              この表示"
  370. 19360         PRINT "---------------------------------------------------"
  371. 19370         PRINT "  '-' のみの入力でファイル名入力を中断できます."
  372. 19380         PRINT "  '\' の代わりに '/' を使って入力できます."
  373. 19390         PRINT "  DEL, REN に ワイルドカードは使えません."
  374. 19400         PRINT "  TYPE 表示中に [S] [SPACE] でポーズ,   [P] [RET] でページストップ,"
  375. 19410         PRINT "                [Q] [C] [ESC] で中断することができます."
  376. 19420         PRINT "  カレントの変更は,ドライブ名を含めて指定できます."
  377. 19430         PRINT "  ファイル名指定に '*','?' が含まれていると,該当のディレクトリを表示します."
  378. 19440         GOTO *FL_NAME2
  379. 19450     ENDIF
  380. 19460 '
  381. 19470 'del fname
  382. 19480     IF FL_PRM$ = "del" OR FL_PRM$ = "DEL" THEN
  383. 19490         GOSUB *FL_PRM
  384. 19500         GOSUB *FL_TGFILE
  385. 19510         GOSUB *FL_EXIST
  386. 19520         IF FL_EXIST = 1 THEN
  387. 19530             ON ERROR GOTO  *FL_DEL_ER
  388. 19540               KILL FL_NAME$
  389. 19550             ON ERROR GOTO  0
  390. 19560         ELSE
  391. 19570             PRINT "ファイルがみつかりません."
  392. 19580         ENDIF
  393. 19590         GOTO *FL_NAME2
  394. 19600     ENDIF
  395. 19610 '
  396. 19620 'ren fname fname
  397. 19630     IF FL_PRM$ = "ren" OR FL_PRM$ = "REN" THEN
  398. 19640         GOSUB *FL_PRM : GOSUB *FL_TGFILE
  399. 19650         FL_OLD$ = FL_NAME$
  400. 19660         GOSUB *FL_PRM : GOSUB *FL_TGFILE
  401. 19670         'if fl_prm$ <> "" then
  402. 19680             ON ERROR GOTO *FL_REN_ER
  403. 19690                 NAME FL_OLD$ AS FL_NAME$
  404. 19700             ON ERROR GOTO 0
  405. 19710         'ENDIF
  406. 19720         GOTO *FL_NAME2
  407. 19730     ENDIF
  408. 19740 '
  409. 19750 'type
  410. 19760     IF FL_PRM$ = "type" OR FL_PRM$ = "TYPE" THEN
  411. 19770         GOSUB *FL_PRM
  412. 19780         GOSUB *FL_TGFILE
  413. 19790         GOSUB *FL_TYPE
  414. 19800         GOTO *FL_NAME2
  415. 19810     ENDIF
  416. 19820 '
  417. 19830 'a:  ドライブ変更
  418. 19840     IF LEN(FL_PRM$) = 2 AND RIGHT$(FL_PRM$,1) = ":" THEN
  419. 19850         FL_NAME$ = FL_PRM$ + ".\"
  420. 19860         GOSUB *FL_DIR_CK
  421. 19870         IF FL_EXIST = 1 THEN
  422. 19880             FL_CDRV$ = FL_PRM$
  423. 19890             FL_CDIR$ = ".\"
  424. 19900         ELSE
  425. 19910             PRINT "ドライブの指定が違います."
  426. 19920         ENDIF
  427. 19930         GOTO *FL_NAME2
  428. 19940     ENDIF
  429. 19950 '
  430. 19960 '
  431. 19970 'cd\ , cd..  ->  cd \ , cd ..
  432. 19980     IF FL_PRM$ = "cd\" OR FL_PRM$ = "CD\" OR FL_PRM$ = "cd.." OR FL_PRM$ = "CD.." THEN
  433. 19990         FL_CLINE$ = MID$(FL_PRM$,3)
  434. 20000         FL_PRM$ = "cd"
  435. 20010     ENDIF
  436. 20020 '
  437. 20030 'cd dir
  438. 20040     IF FL_PRM$ = "cd" OR FL_PRM$ = "CD" THEN
  439. 20050         GOSUB *FL_PRM
  440. 20060         IF FL_PRM$ <> "" THEN
  441. 20070             IF RIGHT$(FL_PRM$,1) <> "\" THEN FL_PRM$ = FL_PRM$ + "\"
  442. 20080             GOSUB *FL_CDCHG
  443. 20090         ELSE
  444. 20100             PRINT FL_CDRV$+FL_CDIR$
  445. 20110         ENDIF
  446. 20120         GOTO *FL_NAME2
  447. 20130     ENDIF
  448. 20140 '
  449. 20150 'dir\   ディレクトリ変更 & files
  450. 20160     IF RIGHT$(FL_PRM$,1) = "\" THEN
  451. 20170         GOSUB *FL_CDCHG
  452. 20180         FL_PRM$ = "*.*"
  453. 20190     ENDIF
  454. 20200 '
  455. 20210 'dir
  456. 20220     IF FL_PRM$ = "dir" OR FL_PRM$ = "DIR" OR FL_PRM$ = "ls" THEN
  457. 20230         GOSUB *FL_PRM
  458. 20240         IF FL_PRM$ = "" THEN
  459. 20250             FL_PRM$ = "*.*"
  460. 20260         ENDIF
  461. 20270         GOSUB *FL_TGFILE
  462. 20280         ON ERROR GOTO *FL_DIR_ER
  463. 20290           FILES FL_NAME$
  464. 20300         ON ERROR GOTO 0
  465. 20310         GOTO *FL_NAME2
  466. 20320     ENDIF
  467. 20330 '
  468. 20340 'ファイル名に '*','?' が含まれる時 files
  469. 20350     FL_I = INSTR(FL_PRM$,"*") + INSTR(FL_PRM$,"?")
  470. 20360     IF FL_I <> 0 THEN
  471. 20370          GOSUB *FL_TGFILE
  472. 20380          ON ERROR GOTO *FL_DIR_ER
  473. 20390            FILES FL_NAME$
  474. 20400          ON ERROR GOTO 0
  475. 20410          ' 空き容量等の表示を消す
  476. 20420          'locate 0,csrlin -1
  477. 20430          'print chr$(13)+space$(78)+chr$(13);
  478. 20440          'locate 0,csrlin -1
  479. 20450          'print chr$(13)+space$(78)+chr$(13);
  480. 20460          GOTO *FL_NAME2
  481. 20470     ENDIF
  482. 20480 '
  483. 20490 '-' 中止確認
  484. 20500     IF FL_PRM$ = "-" THEN
  485. 20510         FL_NAME$ = "-"
  486. 20520         GOTO *FL_NAME_T
  487. 20530     ENDIF
  488. 20540 '
  489. 20550 ' ファイル確認,終了処理
  490. 20560     GOSUB *FL_TGFILE
  491. 20570     GOSUB *FL_EXIST
  492. 20580     IF FL_RDWT = 0 THEN  ' 読み込みのとき ファイル存在確認
  493. 20590         IF FL_EXIST = 0 THEN
  494. 20600             PRINT "指定のファイルはみつかりません."
  495. 20610             GOTO *FL_NAME2
  496. 20620         ENDIF
  497. 20630     ELSE                 ' 書き込みの時 同名ファイルをリネーム
  498. 20640         IF FL_EXIST = 1 THEN
  499. 20650                'ファイル名のみ切り出す
  500. 20660             FL_I = INSTR(FL_NAME$,"\") ' '\'があるか
  501. 20670             IF FL_I <> 0 THEN 'あり
  502. 20680                 FL_I = LEN(FL_NAME$) -1
  503. 20690                 WHILE MID$(FL_NAME$,FL_I,1) <> "\"
  504. 20700                     FL_I = FL_I -1
  505. 20710                 WEND
  506. 20720                 FL_BAK$ = MID$(FL_NAME$,FL_I+1)
  507. 20730             ELSE
  508. 20740                 FL_BAK$ = FL_NAME$
  509. 20750             ENDIF
  510. 20760             FL_I = INSTR(FL_BAK$,".")
  511. 20770             IF FL_I = 0 THEN
  512. 20780                 FL_BAK$ = FL_BAK$ + ".bak"           '拡張子なし
  513. 20790             ELSE
  514. 20800                 FL_BAK$ = LEFT$(FL_BAK$,FL_I-1)+".bak" '拡張子を変更
  515. 20810             ENDIF
  516. 20820             ON ERROR GOTO *FL_SKIP
  517. 20830                 KILL FL_BAK$
  518. 20840             ON ERROR GOTO 0
  519. 20850             NAME FL_NAME$ AS FL_BAK$
  520. 20860         ENDIF
  521. 20870     ENDIF
  522. 20880     IF LEFT$(FL_NAME$,2) = ".\" THEN
  523. 20890         FL_NAME$ = MID$(FL_NAME$,3)
  524. 20900     ENDIF
  525. 20910 *FL_NAME_T
  526. 20920     RETURN
  527. 20930 '
  528. 20940 '-- file_sub ---
  529. 20950 *FL_SKIP
  530. 20960     RESUME NEXT        '削除cancel
  531. 20970 '
  532. 20980 *FL_TGFILE
  533. 20990 ' 対象ファイル名を fl_name$ にセット
  534. 21000 ' in fl_prm$ (fl_cdrv$,fl_cdir$)  out fl_name$
  535. 21010     'drv
  536. 21020     IF MID$(FL_PRM$,2,1) <> ":" THEN
  537. 21030         FL_NAME$ = FL_CDRV$
  538. 21040     ELSE
  539. 21050         FL_NAME$ = LEFT$(FL_PRM$,2)
  540. 21060         FL_PRM$ = MID$(FL_PRM$,3)
  541. 21070     ENDIF
  542. 21080     'dir
  543. 21090     IF LEFT$(FL_PRM$,1) = "\" THEN             ' フルパス指定
  544. 21100         FL_NAME$ = FL_NAME$ + FL_PRM$
  545. 21110     ELSE IF LEFT$(FL_PRM$,3) = "..\" THEN      ' 上ディレクトリ
  546. 21120         FL_I = INSTR(LEFT$(FL_CDIR$,LEN(FL_CDIR$)-1),"\") ' '\'が二つ以上か確認
  547. 21130         IF FL_I <> 0 THEN
  548. 21140             FL_I = LEN(FL_CDIR$) -1
  549. 21150             WHILE MID$(FL_CDIR$,FL_I,1) <> "\"
  550. 21160                 FL_I = FL_I -1
  551. 21170             WEND
  552. 21180             'fl_cdir$ = left$(fl_cdir$,fl_i)
  553. 21190             FL_NAME$ = FL_NAME$ + LEFT$(FL_CDIR$,FL_I) + MID$(FL_PRM$,4)
  554. 21200         ELSE
  555. 21210             FL_NAME$ = FL_NAME$ + FL_CDIR$ + FL_PRM$
  556. 21220         ENDIF
  557. 21230     ELSE                                       ' カレント+指定
  558. 21240         IF FL_CDRV$ = FL_NAME$ THEN
  559. 21250             FL_NAME$ = FL_NAME$ + FL_CDIR$ + FL_PRM$
  560. 21260         ELSE
  561. 21270             FL_NAME$ = FL_NAME$ + FL_PRM$
  562. 21280         ENDIF
  563. 21290     ENDIF
  564. 21300     RETURN
  565. 21310 '
  566. 21320 *FL_CDCHG
  567. 21330 ' ディレクトリ確認, 更新
  568. 21340 ' in fl_prm$ (fl_cdir$,fl_cdrv$)   out fl_cdir$, fl_cdrv$
  569. 21350     GOSUB *FL_TGFILE
  570. 21360     ' ディレクトリ存在確認
  571. 21370     GOSUB *FL_DIR_CK
  572. 21380     IF FL_EXIST = 1 THEN
  573. 21390         IF MID$(FL_NAME$,2,1) = ":" THEN
  574. 21400             FL_CDRV$ = LEFT$(FL_NAME$,2)
  575. 21410             FL_NAME$ = MID$(FL_NAME$,3)
  576. 21420         ENDIF
  577. 21430         FL_CDIR$ = FL_NAME$
  578. 21440     ELSE
  579. 21450         PRINT "ディレクトリの指定が違います."
  580. 21460     ENDIF
  581. 21470     RETURN
  582. 21480 '
  583. 21490 *FL_PRM
  584. 21500 ' fl_cline$ より 1項目 取り出す
  585. 21510 ' in fl_cline$   out fl_prm$ ,fl_cline$
  586. 21520     IF FL_CLINE$ <>"" THEN
  587. 21530         WHILE LEFT$(FL_CLINE$,1) = " "
  588. 21540             FL_CLINE$ = MID$(FL_CLINE$,2)
  589. 21550         WEND
  590. 21560         FL_I = INSTR(FL_CLINE$," ")
  591. 21570         IF FL_I <> 0 THEN
  592. 21580             FL_PRM$ = LEFT$(FL_CLINE$,FL_I-1)
  593. 21590             FL_CLINE$ = MID$(FL_CLINE$,FL_I+1)
  594. 21600         ELSE
  595. 21610             FL_PRM$ = FL_CLINE$
  596. 21620             FL_CLINE$ = ""
  597. 21630         ENDIF
  598. 21640         WHILE LEFT$(FL_CLINE$,1) = " "
  599. 21650             FL_CLINE$ = MID$(FL_CLINE$,2)
  600. 21660         WEND
  601. 21670     ELSE
  602. 21680         FL_PRM$ = ""
  603. 21690     ENDIF
  604. 21700     RETURN
  605. 21710 '
  606. 21720 *FL_TYPE
  607. 21730 ' ファイル内容表示 255文字以上は切捨て
  608. 21740 'in fl_name$
  609. 21750     FL_CNT = -1
  610. 21760     GOSUB *FL_EXIST
  611. 21770     IF FL_EXIST = 1 THEN
  612. 21780         OPEN "I",#9,FL_NAME$
  613. 21790             FL_BRK = 0: FL_CNT = -1
  614. 21800             WHILE EOF(9) = 0 AND FL_BRK = 0
  615. 21810                 LINE INPUT #9,FL_I$
  616. 21820                 PRINT FL_I$
  617. 21830                 FL_I$ = INKEY$
  618. 21840                 FL_CNT = FL_CNT + (FL_CNT>0)
  619. 21850                  IF FL_CNT = 0 THEN FL_I$ = "p"
  620. 21860                 IF FL_I$ = "" THEN
  621. 21870                 ELSE IF INSTR("QqCc"+CHR$(27),FL_I$) THEN
  622. 21880                     FL_BRK = 1
  623. 21890                 ELSE IF INSTR("PpSs "+CHR$(13),FL_I$) THEN
  624. 21900                     FL_I$ = INPUT$(1)
  625. 21910                     IF INSTR("Pp"+CHR$(13),FL_I$) THEN
  626. 21920                         FL_CNT = 22
  627. 21930                     ELSE IF INSTR("QqCc"+CHR$(27),FL_I$) THEN
  628. 21940                         FL_BRK = 1
  629. 21950                     ELSE
  630. 21960                         FL_CNT = -1
  631. 21970                     ENDIF
  632. 21980                 ENDIF
  633. 21990             WEND
  634. 22000         CLOSE #9
  635. 22010     ELSE
  636. 22020         PRINT "ファイルがみつかりません."
  637. 22030     ENDIF
  638. 22040     RETURN
  639. 22050 '
  640. 22060 *FL_EXIST
  641. 22070 'ファイル存在確認
  642. 22080 'in fl_name$      out fl_exist    1 ..ファイルあり  0 .. ファイルなし
  643. 22090     FL_EXIST = 1
  644. 22100     'print "f_EXIST ";fl_name$
  645. 22110     ON ERROR GOTO *FL_EXIST3
  646. 22120         OPEN "I",#9,FL_NAME$
  647. 22130         CLOSE #9
  648. 22140 *FL_EXIST2
  649. 22150     ON ERROR GOTO 0
  650. 22160     RETURN
  651. 22170 *FL_EXIST3
  652. 22180     IF ERR = 63 OR ERR = 75 OR ERR = 55 THEN
  653. 22190         FL_EXIST = 0
  654. 22200     ELSE
  655. 22210         PRINT ERR,ERL
  656. 22220     ENDIF
  657. 22230     RESUME *FL_EXIST2
  658. 22240 '
  659. 22250 *FL_DIR_CK
  660. 22260 ' ディレクトリ存在確認
  661. 22270 ' in fl_name$   out fl_exist
  662. 22280     FL_EXIST = 0
  663. 22290     ON ERROR GOTO *FL_DIR_CK_3
  664. 22300         OPEN "O",#9,FL_NAME$+"nul" :CLOSE #9
  665. 22310 *FL_DIR_CK_2
  666. 22320     ON ERROR GOTO 0
  667. 22330     RETURN
  668. 22340 *FL_DIR_CK_3
  669. 22350     IF ERR = 72 THEN
  670. 22360         PRINT "指定されたディスク装置が使用可能な状態になっていません."
  671. 22370     ELSE IF ERR = 75 THEN
  672. 22380         PRINT "デバイスまたはファイルのアクセスが拒否されました."
  673. 22390     ELSE IF ERR = 63 THEN
  674. 22400         'print "指定のディレクトリがみつかりません."
  675. 22410     ELSE IF ERR = 64 OR ERR = 73 THEN
  676. 22420         FL_EXIST = 1
  677. 22430     ELSE IF ERR = 55 THEN
  678. 22440         'ファイルの記述に誤りがあります
  679. 22450     ELSE
  680. 22460         PRINT ERR,ERL
  681. 22470         STOP
  682. 22480     ENDIF
  683. 22490     RESUME *FL_DIR_CK_2
  684. 22500     ' 63 指定のファイルがみつかりません
  685. 22510     ' 64 指定のファイルはすでに存在しています
  686. 22520     ' 72 指定されたディスク装置が使用可能な状態になっていません
  687. 22530     ' 73 指定されたディスクは書き込みが禁止されています
  688. 22540     ' 75 デバイスまたはファイルのアクセスが拒否されましてた
  689. 22550     ' 55 ファイルの記述に誤りがあります
  690. 22560 '
  691. 22570 '-- 各エラー処理 --
  692. 22580 *FL_DIR_ER
  693. 22590     PRINT "ファイルがみつかりません."
  694. 22600     RESUME NEXT
  695. 22610 '
  696. 22620 *FL_DEL_ER
  697. 22630     PRINT "ファイルを削除できません."
  698. 22640     RESUME NEXT
  699. 22650 '
  700. 22660 *FL_REN_ER
  701. 22670     PRINT "ファイル名が重複しているか, またはファイルがみつかりません."
  702. 22680     RESUME NEXT
  703. 22690 '
  704.